5 REM   CUSTOM CHARACTER EDITOR
6 REM            FROM
7 REM COMPUTE!'S BOOK OF GRAPHICS
8 REM    KEYED IN BY JOHN MOORE
9 REM          1983 12 15
10 REM ** CHANGE SCREEN POINTERS **
20 PRINT CHR$(8);
30 POKE 56578,PEEK(56578)OR3
40 POKE 56576,(PEEK(56576)AND252)OR0
50 POKE53272,(PEEK(53272)AND240)OR2
60 POKE648,196:FF=0
70 REM
80 REM ** TRANSFER CHARACTER SET **
90 REM
100 POKE 56334,PEEK(56334)AND254
110 POKE 1,PEEK(1)AND251
120 FOR R=53248 TO 55296
130 POKER-2048,PEEK(R):NEXT
140 POKE1,PEEK(1)OR4
150 POKE56334,PEEK(56334)OR1
160 REM
170 REM ** DEFINE CHARACTER GRID **
175 LZ$(0)="[207]":LZ$(1)=" [146]"
180 REM
190 CG$=""
195 CF$=""
200 FOR R=0 TO 7
210 CG$=CG$+"[207][207][207][207][207][207][207][207][165][157][157][157][157][157][157][157][157][157]"
215 CF$=CF$+"        [146][165][157][157][157][157][157][157][157][157][157]":NEXT
220 CG$ = CG$+"[163][163][163][163][163][163][163][163]"
230 REM
240 REM DEFINE CHARACTER DISPLAY
250 REM
260 CD$="@ABCDEFGHIJKLMNOPQRSTUVWXYZ"
270 CD$=CD$+"\^_ !"+CHR$(34)
280 CD$=CD$+"#$%&'()*+,-./"
290 CD$=CD$+"0123456789:;<=>?[192][193][194][195][196]"
300 CD$=CD$+"[218][219][220][221][255][223] [161][162][163][164][165][166][167][168][170][171][172][173][174]"
310 CD$=CD$+"[197][198][199][200][201][202][203][204][205][206][207][208][209][210][211][212][213][214][215][216][217]"
320 CD$=CD$+"[175][176][177][178][179][180][181][182][183][184][185][186][187][188][189][190][191]"
330 REM
340 REM ** DEFINE FUNCTION KEYS **
350 REM
351 FOR R=1TO30:S$=S$+"":NEXT
360 FORN=1TO8 STEP 2
370 K$(N)="[162][162][162][162][162][157][157][157][157][157] F"+STR$(N)+" [157][157][157][157][157][157][157][146][167][162][162][162][162][162][146] [165]"
380 K$(N+1)="[167][169] F"+STR$(N+1)+" [223][146][165]"
390 P$(N)="[176][192][192][192][174][157][157][157][157][157][194]F"+STR$(N)+"[194][157][157][157][157][157][157][157][146][167] [173][192][192][192][189][146] [165]"
400 P$(N+1)="[167][206] F"+STR$(N+1)+" [205][146][165][157][157][157][157][157][157][157][157][157][148][148][163][163][163][163][163][145]":NEXT
405 REM
410 REM ** DEFINE KEY POSITIONS **
415 REM
420 FOR R=1TO8:K$(R)=""+K$(R):NEXT
430 FORR=1TO7STEP2:K$(R)=""+SP$+K$(R):SP$=SP$+"":NEXT
440 SP$="":FORR=2TO8STEP2:K$(R)=""+SP$+K$(R):SP$=SP$+"":NEXT:SP$=""
450 FORR=1TO8:P$(R)=""+P$(R):NEXT
460 FORR=1TO7STEP2:P$(R)=""+SP$+P$(R):SP$=SP$+"":NEXT
470 SP$="":FORR=2TO8STEP2:P$(R)=""+SP$+P$(R):SP$=SP$+"":NEXT
480 REM
490 REM ** DEFINE MESSAGES **
500 REM
510 M$(1)="EDIT....[157][157][157][157][157][157][157][157]SAVE....[157][157][157][157][157][157][157][157]"
520 M$(1)=M$(1)+"LOAD....[157][157][157][157][157][157][157][157]COPY....[157][157][157][157][157][157][157][157]CLEAR...[157][157][157][157][157][157][157][157]"
530 M$(1)=M$(1)+"FILL....[157][157][157][157][157][157][157][157]WORK....[157][157][157][157][157][157][157][157]FUNCTION"
540 M$(2)="REVERSE.[157][157][157][157][157][157][157][157]INVERT..[157][157][157][157][157][157][157][157]"
550 M$(2)=M$(2)+"FLIP....[157][157][157][157][157][157][157][157]SCROLL R[157][157][157][157][157][157][157][157]SCROLL L[157][157][157][157][157][157][157][157]"
560 M$(2)=M$(2)+"SCROLL U[157][157][157][157][157][157][157][157]SCROLL D[157][157][157][157][157][157][157][157]FUNCTION"
570 REM
580 REM ** DEFINE RULER LINES **
590 REM
600 L$="[192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]"
610 L$=L$+"[192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]"
620 L$=L$+"[221][157][221][157][221][157][221][157][221][157][221][157][221][157][221][157][221][157][221][157][221][157][221][157][221][157][221]"
630 L$=L$+"[157][221][157][221][157][221][157][221][145][145][145][145][145][145][145][145][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]"
900 REM
910 REM ** DISPLAY EDIT SCREEN **
920 REM
930 PRINT"[147]";CD$:PRINTCG$:PRINTL$:PRINTM$(1)
940 REM
941 REM ** EDIT CHARACTERS **
942 REM
945 A$="@"
1000 REM
1010 REM ** DISPLAY FUNCTION KEYS **
1020 REM
1025 POKE 55753,14
1030 PRINT"";:FOR R=1TO8:PRINTK$(R);:NEXT:PRINT"";
1040 A(0)=1:A(1)=3:A(2)=5:A(3)=7:A(4)=2:A(5)=4:A(6)=6:A(7)=8
1045 GOTO1087
1050 REM
1060 REM ** GET KEYBOARD ENTRY **
1070 REM
1080 PRINT"ENTER FUNCTION:                       "
1082 GETA$:IFA$=""THEN1080
1084 REM
1085 REM  -- SKIP INVALID KEYS --
1086 REM
1087 VA=ASC(A$)
1088 IF (VA<32 OR VA>223)THEN1080
1089 IF (VA>95 AND VA<133)THEN1080
1090 IF (VA>140 AND VA<161)THEN1080
1091 IF (VA>140 OR VA<132)THEN1205
1100 REM
1110 REM -- GET FUNCTION KEYS --
1120 REM
1130 PRINTP$(A(ASC(A$)-133))
1140 FOR R=0TO99:NEXT
1150 PRINTK$(A(ASC(A$)-133));"";
1160 GOTO 1390
1180 REM
1190 REM -- CONVERT TO SCREEN CODE --
1200 REM
1205 LT=VA
1210 IF VA>31 AND VA<64 THEN SC=VA:GOTO1240
1220 IF VA>63 AND VA<193 THEN SC=VA-64: GOTO 1240
1230 IF VA>191 AND VA<224 THEN SC=VA-128: GOTO1240
1240 REM
1250 REM -- DISPLAY EDITED CHARACTER --
1260 REM
1262 LT$=STR$(LT):LT$=RIGHT$(LT$,LEN(LT$)-1)
1265 PRINT"ENTRY MODE: CHR$(";LT$;")                 "
1270 POKE50633,SC
1273 PRINT"";
1275 PRINT"ENTRY MODE: CHR$(";LT$;")                 "
1276 POKE 50633,SC
1277 PRINT"";
1278 FOR R=0 TO7
1279 RR=PEEK(R+(51200+8*SC))
1280 PRINTLZ$(ABS((RRAND128)=128));LZ$(ABS((RRAND64)=64));LZ$(ABS((RRAND32)=32));
1281 PRINTLZ$(ABS((RRAND16)=16));LZ$(ABS((RRAND8)=8));LZ$(ABS((RRAND4)=4));
1282 PRINTLZ$(ABS((RRAND2)=2));LZ$(ABS((RRAND1)=1));"[157][157][157][157][157][157][157][157]";:NEXT:GOTO 1080
1350 GOTO 1080
1360 REM
1370 REM -- SPECIAL FUNCTION ROUTINES --
1380 REM
1390 IF FF=1 THEN 1500
1400 ON A(ASC(A$)-133) GOTO 2005,1433,1443,1453,1462,1472,1483,1493
1410 GOTO 1170
1430 REM
1431 REM -- SAVE A CHARACTER SET --
1432 REM
1433 PRINT"SAVE ON CASSETTE OR DISK? (C/D):      "
1434 GET Q$:IFQ$=""THEN1434
1435 IF Q$<>"C" AND Q$<>"D" THEN 1087
1436 GOTO 1760
1440 REM
1441 REM -- LOAD A CHARACTER SET --
1442 REM
1443 PRINT"LOAD FROM CASSETE OR DISK? (C/D):    "
1444 GET Q$: IF Q$=""THEN 1444
1445 IF Q$<>"C" AND Q$<>"D" THEN 1087
1446 GOTO 1910
1450 REM
1451 REM -- (null) A CHARACTER --
1452 REM
1453 PRINT"ENTER CHARACTER TO COPY:              "
1454 GET CA$:IF CA$="" THEN 1454
1455 GOTO 1605
1456 IF CA$="" THEN 1454
1459 GOTO 1275
1460 REM
1461 REM -- CLEAR A CHARACTER --
1462 PRINT"CLEAR CHAR: CHR$(";LT$;")                 "
1463 H=51200+8*SC
1464 FOR R=H TO H+7: POKE R,0:NEXT
1465 PRINTCG$:GOTO 1080
1470 REM
1471 REM -- FILL A CHARACTER --
1472 PRINT"FILL  CHAR: CHR$(";LT$;")                  "
1473 H=51200+8*SC
1474 FOR R=H TO H+7: POKE R,255: NEXT
1475 PRINT CF$:GOTO 1080
1480 REM
1481 REM -- GOTO WORK SPACE --
1482 REM
1483 PRINT"ENABLE WORK SPACE                      "
1484 GOTO 2705
1490 REM
1491 REM -- SWITCH FUNCTION SET --
1492 REM
1493 FF=1:PRINTM$(2):GOTO 1080
1499 RETURN
1500 ON A(ASC(A$)-133)GOTO 1523,1532,1542,1551,1561,1572,1582,1593
1510 GOTO 1170
1520 REM
1521 REM -- REVERSE CHARACTER BITS --
1522 REM
1523 PRINT"REVERSE CHARACTER:                    "
1524 H=51200+8*SC
1525 FOR R=H TO H+7:POKE R,255-PEEK(R):NEXT
1529 GOTO 1275
1530 REM
1531 REM -- INVERT CHARACTER SET --
1532 PRINT"INVERTING CHARACTER:                  "
1533 H=51200+8*SC
1534 FOR R=H TO H+7: T(R-H)=PEEK(R):NEXT
1535 FOR R=H TO H+7: POKE R,T(7-(R-H)):NEXT:GOTO1275
1540 REM
1541 REM -- FLIP CHARACTERS --
1542 PRINT"FLIPPING CHARACTER:                   "
1543 FOR U=51200+8*SC TO (51200+8*SC)+7
1544 Z=PEEK(U)
1545 R=128*(ABS((ZAND1)=1))+64*(ABS((ZAND2)=2))+32*(ABS((ZAND4)=4))
1546 R=R+16*(ABS((ZAND8)=8))+8*(ABS((ZAND16)=16))+4*(ABS((ZAND32)=32))
1547 R=R+2*(ABS((ZAND64)=64))+1*(ABS((ZAND128)=128))
1548 POKE U,R
1549 NEXT:GOTO1275
1550 REM -- SCROLL RIGHT --
1551 PRINT"SCROLLING RIGHT:                      "
1552 FOR U=51200+8*SC TO (51200+8*SC)+7
1553 R=(PEEK(U)/2)
1554 IF PEEK(U)/2<>INT(PEEK(U)/2) THEN R=R+128
1555 POKE U,R
1556 NEXT:GOTO1275
1560 REM -- SCROLL LEFT --
1561 PRINT"SCROLLING LEFT:                       "
1562 FOR U=51200+8*SC TO (51200+8*SC)+7
1563 R=PEEK(U)*2)
1564 IF PEEK(U)=>128 THEN R=R+1
1565 IF R>255 THEN R=R-256
1566 POKE U,R
1567 NEXT:GOTO1275
1570 REM
1571 REM -- SCROLL UP --
1572 PRINT"SCROLLING UP:                         "
1573 FOR R=0TO7
1574 Y(R)=PEEK(R+51200+8*SC):NEXT
1575 FOR R=0TO6
1576 POKE R+51200+8*SC, Y(R+1):NEXT
1577 POKE 51207+8*SC, Y(0)
1578 GOTO 1275
1580 REM
1581 REM -- SCROLL  DOWN --
1582 PRINT"SCROLLING DOWN:                       "
1583 FOR R=0TO7
1584 Y(R)=PEEK(R+51200+8*SC):NEXT
1585 FOR R=1TO7
1586 POKE R+51200+8*SC, Y(R-1):NEXT
1587 POKE 51200+8*SC, Y(7)
1589 GOTO 1275
1590 REM
1591 REM -- SWITCH FUNCTION SET --
1592 REM
1593 FF=0:PRINTM$(1):GOTO1080
1599 RETURN
1600 REM
1601 REM  ** (null) CHARACTER ROUTINE **
1602 REM
1605 DA=ASC(CA$)
1610 IF (DA<32 OR DA>223) THEN 1456
1620 IF (DA>95 AND DA<133) THEN 1456
1630 IF (DA<141 AND DA>132) THEN A$=CA$:GOTO 1080
1640 IF (DA>140 AND DA<161) THEN RETURN
1650 PRINT"";CA$
1660 IF DA>31 AND DA<64 THEN SD=DA: GOTO 1690
1670 IF DA>63 AND DA<193 THEN SD=DA-64: GOTO 1690
1680 IF DA>191 AND DA<224 THEN SD=DA-128: GOTO 1690
1690 VJ=51200+8*SD:JJ=51200+8*SC
1700 FOR R=0TO7
1710 POKE JJ+R,PEEK(VJ+R):NEXT
1720 GOTO 1456
1730 REM
1740 REM ** SAVE CHAR SET ROUTINE **
1750 REM
1760 PRINT"SAVE:FILE NAME ------.CHR        ";
1770 LL=0:NM$=""
1775 FOR R=0TO30:PRINT"-[146][157]";
1780 GET A$:IFA$=""THEN NEXT
1790 IFA$<>""THEN 1840
1800 FOR R=0 TO 30:PRINT"-[157]";
1810 GET A$:IF A$=""THEN NEXT
1820 IF A$<>"" THEN 1840
1830 GOTO 1775
1840 IFA$=CHR$(20)ORA$=CHR$(148)ORA$=CHR$(13) OR A$=CHR$(34) OR A$="[145]"THEN1775
1845 IFA$="" OR A$="" OR A$="[157]" THEN 1775
1847 IF ASC(A$)>132 AND ASC(A$)<141 THEN 1080
1850 PRINT A$;
1855 NM$=NM$+A$:LL=LL+1:IF LL=6 THEN 1870
1860 GOTO 1775
1870 NM$=NM$+".CHR"
1875 IF Q$="C"THEN1890
1880 OPEN1,8,4,NM$+",W"
1885 FOR R=51200 TO 52224
1887 PRINT#1,PEEK(R):NEXT
1889 CLOSE1:GOTO1275
1890 OPEN1,1,1,NM$:GOTO1885
1900 REM
1901 REM ** SAVE CHAR SET ROUTINE **
1902 REM
1910 PRINT"LOAD: FILE NAME ------.CHR        ";
1915 LL=0:NM$=""
1920 FOR R=0TO30: PRINT"-[146][157]";
1925 GET A$:IFA$=""THEN NEXT
1930 IFA$<>""THEN 1955
1935 FOR R=0TO30: PRINT"-[157]";
1940 GET A$:IFA$=""THEN NEXT
1945 IFA$<>""THEN 1955
1950 GOTO 1920
1955 IFA$=CHR$(20)ORA$=CHR$(148)ORA$=CHR$(13)ORA$=CHR$(34)ORA$="[145]"THEN 1920
1960 IFA$=""ORA$=""ORA$="[157]"THEN 1920
1965 IF ASC(A$)>132 AND ASC(A$)<141 THEN 1080
1970 PRINTA$;
1975 NM$=NM$+A$:LL=LL+1:IFLL=6THEN1980
1976 GOTO1920
1980 NM$=NM$+".CHR"
1985 IF Q$="C"THEN 1999
1987 OPEN1,8,4,NM$+",R"
1988 FOR R=51200 TO 52224
1989 INPUT#1,VL:POKE R,VL:NEXT
1990 CLOSE1:GOTO 1275
1999 OPEN1,1,1,NM$:GOTO 1885
2000 REM
2001 REM ** CHARACTER EDIT ROUTINE **
2002 REM
2005 PRINT"EDIT  MODE: CHR$(";LT$;")                 "
2010 PRINT"";
2015 LO=50462: SV=PEEK(LO) :SM=(51200+(8*SC)): EX=7 :GT=SC
2020 FOR R=0TO30:POKE LO,SV
2030 GET A$:IFA$=""THEN NEXT
2040 IFA$<>""THEN 2090
2050 FOR R=0TO30: POKE LO,102
2060 GET A$: IFA$=""THEN NEXT
2070 IFA$<>""THEN 2090
2080 GOTO 2020
2090 IFA$="[145]"THEN 2200
2091 IFA$=""THEN 2100
2092 IFA$="[157]"THEN 2300
2093 IFA$=""THEN 2400
2094 IF A$=CHR$(32) AND SV=160 THEN 2500
2095 IF A$=CHR$(32) AND SV=79 THEN 2600
2099 POKE LO,SV:GOTO 1087
2100 POKE LO,102:FOR R=0TO40: NEXT
2110 IF GT=SC+7 THEN 2020
2120 POKE LO,SV:LO=LO+40:GT=GT+1:SV=PEEK (LO):SM=SM+1:GOTO2020
2200 POKE LO,102:FOR R=0TO40:NEXT
2210 IF GT=SC THEN 2020
2220 POKELO,SV:LO=LO-40:GT=GT-1:SV=PEEK(LO):SM=SM-1:GOTO 2020
2300 POKE LO,102:FOR R=0TO40:NEXT
2310 IF EX=7 THEN 2020
2320 POKE LO,SV: LO=LO-1:EX=EX+1:SV=PEEK(LO):GOTO2020
2400 POKE LO,102:FOR R=0TO40: NEXT
2410 IF EX=0 THEN 2020
2420 POKE LO,SV:LO=LO+1:EX=EX-1:SV=PEEK(LO):GOTO 2020
2500 POKE LO,79:POKE SM,PEEK(SM)-(2^EX):SV=79:GOTO 2020
2600 POKE LO,160:POKE SM,PEEK(SM)+(2^EX):SV=160:GOTO2020
2700 REM
2701 REM ** WORK SPACE ROUTINE **
2702 REM
2705 HZ=0:LZ=0
2710 PRINT"";
2720 FOR R=0TO30:PRINT" [146][157]";
2730 GET A$:IF A$=""THEN NEXT
2740 IFA$<>""THEN2790
2750 FOR R=0TO30: PRINT" [157]";
2760 GET A$:IFA$=""THEN NEXT
2770 IFA$<>""THEN 2790
2780 GOTO 2720
2790 IFA$=CHR$(20)ORA$=CHR$(148)ORA$=CHR$(13)ORA$=CHR$(34)THEN2720
2810 IF ASC(A$)>132 AND ASC(A$)<141 THEN PRINT" ";:GOTO 1087
2820 IFA$="[145]" THEN 3200
2830 IFA$="" THEN 3100
2840 IFA$="[157]" THEN 3300
2850 IFA$="" THEN 3400
2860 IF HZ<18 AND LZ<6 THEN PRINTA$;:HZ=HZ+1:GOTO2720
2870 IF HZ=18 AND LZ<6 THEN 2720
2880 IF HZ=18 AND LZ=6 THEN 2720
3100 IF LZ=6 THEN 2720
3110 PRINT" [157]";:LZ=LZ+1:GOTO2720
3200 IF LZ=0 THEN 2720
3210 PRINT" [157][145]";:LZ=LZ-1:GOTO2720
3300 IF HZ=0 THEN 2720
3310 PRINT" [157][157]";:HZ=HZ-1:GOTO 2720
3400 IF HZ=18 THEN 2720
3410 PRINT" [157]";:HZ=HZ+1:GOTO 2720